Чтение файла

hogwarts <- read_csv("data/hogwarts_2024.csv")
hogwarts |> head()
## # A tibble: 6 × 60
##      id house    course sex   wandCore bloodStatus result Defence against the …¹
##   <dbl> <chr>     <dbl> <chr> <chr>    <chr>        <dbl>                  <dbl>
## 1     1 Ravencl…      4 fema… unicorn… half-blood      94                     73
## 2     2 Hufflep…      5 male  phoenix… half-blood      33                     38
## 3     3 Ravencl…      4 fema… dragon … half-blood     137                     52
## 4     4 Hufflep…      2 male  phoenix… half-blood      27                     50
## 5     5 Hufflep…      2 fema… phoenix… half-blood      67                     47
## 6     6 Gryffin…      6 male  phoenix… muggle-born    126                     44
## # ℹ abbreviated name: ¹​`Defence against the dark arts exam`
## # ℹ 52 more variables: `Flying exam` <dbl>, `Astronomy exam` <dbl>,
## #   `Herbology exam` <dbl>, `Divinations exam` <dbl>, `Charms exam` <dbl>,
## #   `History of magic exam` <dbl>, `Arithmancy exam` <dbl>,
## #   `Care of magical creatures exam` <dbl>, `Muggle studies exam` <dbl>,
## #   `Study of ancient runes exam` <dbl>, `Transfiguration exam` <dbl>,
## #   `Potions exam` <dbl>, week_1 <dbl>, week_2 <dbl>, week_3 <dbl>, …
hogwarts |> glimpse()
## Rows: 560
## Columns: 60
## $ id                                   <dbl> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11…
## $ house                                <chr> "Ravenclaw", "Hufflepuff", "Raven…
## $ course                               <dbl> 4, 5, 4, 2, 2, 6, 7, 5, 2, 3, 7, …
## $ sex                                  <chr> "female", "male", "female", "male…
## $ wandCore                             <chr> "unicorn hair", "phoenix feather"…
## $ bloodStatus                          <chr> "half-blood", "half-blood", "half…
## $ result                               <dbl> 94, 33, 137, 27, 67, 126, 63, 7, …
## $ `Defence against the dark arts exam` <dbl> 73, 38, 52, 50, 47, 44, 51, 47, 2…
## $ `Flying exam`                        <dbl> 33, 36, 73, 42, 41, 52, 34, 34, 2…
## $ `Astronomy exam`                     <dbl> 57, 45, 66, 49, 57, 59, 58, 37, 5…
## $ `Herbology exam`                     <dbl> 73, 50, 62, 39, 38, 46, 59, 23, 2…
## $ `Divinations exam`                   <dbl> 66, 54, 72, 42, 47, 49, 42, 38, 1…
## $ `Charms exam`                        <dbl> 60, 70, 77, 46, 35, 55, 86, 20, 4…
## $ `History of magic exam`              <dbl> 52, 36, 60, 45, 50, 40, 55, 21, 2…
## $ `Arithmancy exam`                    <dbl> 61, 36, 58, 32, 76, 50, 41, 31, 2…
## $ `Care of magical creatures exam`     <dbl> 44, 41, 70, 36, 46, 73, 29, 36, 4…
## $ `Muggle studies exam`                <dbl> 64, 34, 52, 59, 50, 54, 36, 31, 4…
## $ `Study of ancient runes exam`        <dbl> 50, 35, 59, 39, 48, 56, 47, 41, 3…
## $ `Transfiguration exam`               <dbl> 74, 70, 70, 15, 32, 86, 100, 31, …
## $ `Potions exam`                       <dbl> 67, 38, 22, 64, 56, 60, 62, 55, 1…
## $ week_1                               <dbl> 0, -5, 0, -1, 1, 5, 1, -20, 3, -2…
## $ week_2                               <dbl> -10, 1, 0, 5, 20, 10, -5, 10, 1, …
## $ week_3                               <dbl> 0, -1, 1, -5, 10, -5, 3, -5, -3, …
## $ week_4                               <dbl> 10, 1, -1, 10, -10, 10, 0, -10, -…
## $ week_5                               <dbl> 3, -5, 3, 0, -1, 20, 5, 5, -3, 5,…
## $ week_6                               <dbl> -20, 20, 0, 0, 0, 0, 0, 5, 0, -1,…
## $ week_7                               <dbl> 10, 10, 1, -3, -20, 1, 10, 3, -5,…
## $ week_8                               <dbl> 5, 5, 1, -5, 5, 5, 0, 1, 0, 20, -…
## $ week_9                               <dbl> 1, 1, 3, -1, 0, 3, -20, -20, -10,…
## $ week_10                              <dbl> 20, -10, 1, 5, -1, 0, 5, -5, 5, 3…
## $ week_11                              <dbl> 5, -10, 20, 0, 0, 0, 5, 10, 5, 5,…
## $ week_12                              <dbl> 5, -5, 1, -20, -10, -5, 0, 5, 1, …
## $ week_13                              <dbl> -20, -5, 10, 0, 0, 1, -1, 10, -20…
## $ week_14                              <dbl> 0, 5, 3, 10, -10, 20, 0, -20, -20…
## $ week_15                              <dbl> 1, 20, 1, 0, -20, 10, 1, 3, -20, …
## $ week_16                              <dbl> 20, 5, 5, 5, 0, 3, 10, -1, 5, 5, …
## $ week_17                              <dbl> 3, 0, 10, 5, 5, -5, -1, 10, -10, …
## $ week_18                              <dbl> 10, 5, 5, 5, 10, -20, 0, 10, 3, 5…
## $ week_19                              <dbl> -10, 0, -5, -1, 0, -1, 0, 20, 0, …
## $ week_20                              <dbl> 10, -10, 5, 10, 0, -1, -1, 10, 0,…
## $ week_21                              <dbl> 0, 5, 5, 3, 5, 0, 0, -5, -5, 5, 5…
## $ week_22                              <dbl> 20, -5, 5, 0, 20, 5, -1, 0, 0, 20…
## $ week_23                              <dbl> 5, 1, -3, 20, -5, 20, 0, 1, 1, 5,…
## $ week_24                              <dbl> 10, -20, -20, 0, 10, 5, 5, -3, -5…
## $ week_25                              <dbl> 0, -20, 1, 3, 5, 1, -5, 0, -20, 2…
## $ week_26                              <dbl> 10, 10, 5, -1, 0, 5, 5, -3, 0, 20…
## $ week_27                              <dbl> 5, 5, -3, 0, 20, 5, 0, -5, 10, 3,…
## $ week_28                              <dbl> -3, 20, 20, 1, 10, 5, 1, 10, 0, 1…
## $ week_29                              <dbl> -20, -5, 5, 5, -10, 1, 0, -3, 0, …
## $ week_30                              <dbl> 5, 1, -5, 5, -5, -1, -20, 20, 1, …
## $ week_31                              <dbl> 5, 5, 20, -5, -10, -3, 0, -10, 20…
## $ week_32                              <dbl> -5, 1, 20, -1, -10, 5, 10, 1, 0, …
## $ week_33                              <dbl> 0, 10, 3, 3, 0, 0, -1, 0, -20, 3,…
## $ week_34                              <dbl> 0, -1, 0, 0, 10, 3, 20, -5, 10, 3…
## $ week_35                              <dbl> 5, -5, 3, -10, 3, -5, 0, 0, 0, 0,…
## $ week_36                              <dbl> 1, 5, 1, -20, 5, 20, -1, -3, 1, 3…
## $ week_37                              <dbl> 0, 0, 10, -1, 10, 3, 3, 0, 20, 1,…
## $ week_38                              <dbl> 10, -1, 0, -5, 5, 5, 20, -5, -3, …
## $ week_39                              <dbl> 3, 5, 1, 10, 20, 0, 5, 1, -5, 0, …
## $ week_40                              <dbl> 0, 0, 5, 1, 5, 1, 10, -5, -20, 3,…
hogwarts <- hogwarts |> mutate(
  across(c(house, course, sex, wandCore, bloodStatus), ~ as.factor(.x))
)

Диаграммы рассеяния (скаттерплоты)

  1. Постройте скаттерплот, визуализирующий связь между суммарным баллом студента за год и оценкой за экзамен по травологии. Добавьте на график линию тренда. Удалите доверительную область и сделайте линию прямой. Подумайте, как избежать того, чтобы записать одни и те же координаты x и y дважды. Проинтерпретируйте график. (1 б.)
theme_custom <- theme(
    axis.text = element_text(size = 20),
    axis.title = element_text(size = 25),
    legend.text = element_text(size = 20),
    legend.title = element_text(size = 20),
    plot.title = element_text(size = 25, hjust = 0.5),
    strip.text = element_text(size = 25)
)

ggplot(hogwarts)+
  geom_point(aes(x = result, y = `Herbology exam`), size = 3)+ 
  geom_smooth(aes(x = result, y = `Herbology exam`), method = "lm", se = FALSE, color = "red")+
  labs(
    title = "Суммарный балл vs Оценка за экзамен по травологии",
    x = "Суммарный балл за год",
    y = "Оценка за экзамен по травологии"
  )+
  theme_bw()+ 
  theme_custom

График показывает положительную линейную зависимость между общим годовым баллом и оценкой за экзамен по травологии. Это подтверждается восходящим наклоном линии тренда. Распределение данных указывает на то, что высокие итоговые баллы чаще встречаются у успешных студентов, которые обычно получают хорошие оценки и по другим предметам. Однако заметны некоторые отклонения, особенно среди студентов с низкими баллами, что может свидетельствовать о разных уровнях успеваемости среди учащихся.

  1. Отобразите на одной иллюстрации скаттерплоты, аналогичные тому, что вы делали на первом задании, для экзаменов по травологии, магловедению, прорицаниям и зельеварению. На иллюстрации также должна присутствовать линия тренда с характеристиками, аналогичными тем, что были в пункте 1. Раскрасьте точки в разные цвета, в соответствии с факультетами. Используйте стандартные цвета факультетов (как в лекционных rmd). Проинтерпретируйте полученный результат. (1 б). Если вы создадите иллюстрацию из этого пункта, используя только пакеты семейства tidyverse, и не привлекая дополнительные средства, вы получите дополнительные 0.5 б.
house_colors <- c("Gryffindor" = "#C50000",
                  "Hufflepuff" = "#ECB939",
                  "Ravenclaw" = "#41A6D9",
                  "Slytherin" = "#1F5D25")

hogwarts %>%
  pivot_longer(cols = c(`Herbology exam`, `Muggle studies exam`, 
                        `Divinations exam`, `Potions exam`),
               names_to = "exam",
               values_to = "score") %>%
  mutate(exam = recode(exam,
                       `Herbology exam` = "Экзамен по травологии",
                       `Muggle studies exam` = "Экзамен по магловедению",
                       `Divinations exam` = "Экзамен по прорицаниям",
                       `Potions exam` = "Экзамен по зельеварению")) %>%
  ggplot(aes(x = result, y = score, color = house)) +
  geom_point(size = 3) + 
  geom_smooth(method = "lm", se = FALSE) +
  facet_wrap(~ exam, scales = "free_y") +  
  scale_color_manual(values = house_colors) +  
  labs(
    title = "Скаттерплоты для различных экзаменов с линиями тренда",
    x = "Суммарный балл за год",
    y = "Оценка за экзамен"
  ) +
  theme_bw()+
  theme_custom

На экзаменах по прорицаниям, травологии и магловедению наблюдается положительная корреляция между итоговым баллом студента и оценкой за экзамен. Однако на экзамене по зельеварению линейная зависимость отсутствует, и успешность может зависеть от других факторов.

  1. Видоизмените график, полученный на предыдущем шаге. Сгруппируйте и покрасьте линии тренда в соответствии с одной из категориальных переменных (с такой, которая подсвечивает одно из наблюдений на предыдущем этапе, относящееся ко всем 4-м экзаменам). Постарайтесь избежать коллизий в легенде, при этом сохранив и цветовую палитру для раскраски точек по факультетам. (1 б.)
hogwarts %>%
  pivot_longer(cols = c(`Herbology exam`, `Muggle studies exam`, 
                        `Divinations exam`, `Potions exam`),
               names_to = "exam",
               values_to = "score") %>%
  mutate(exam = recode(exam,
                       `Herbology exam` = "Экзамен по травологии",
                       `Muggle studies exam` = "Экзамен по магловедению",
                       `Divinations exam` = "Экзамен по прорицаниям",
                       `Potions exam` = "Экзамен по зельеварению")) %>%
  ggplot(aes(x = result, y = score, color = house)) +
  geom_point() +
  geom_smooth(aes(group = sex, color = sex), method = "lm", se = FALSE, linetype = "solid") + 
  facet_wrap(~ exam, scales = "free") +
  labs(
    title = "Скаттерплоты для различных экзаменов с линиями тренда по полу",
    x = "Суммарный балл за год",
    y = "Оценка за экзамен"
  ) +
  scale_fill_manual(values = c("Gryffindor" = "#C50000", 
                             "Hufflepuff" = "#ECB939", 
                             "Ravenclaw" = "#41A6D9", 
                             "Slytherin" = "#1F5D25"))+
  theme_bw() +
  theme_custom

## geom_col и вещи вокруг него

  1. Постройте барплот (столбиковую диаграмму) распределения набранных баллов за первый семестр (с 1-й по 17-ю неделю включительно) у студентов разного происхождения. Если у вас возникают трудности, можете обратиться к шпаргалке по dplyr от posit. Выдвиньте гипотезу (или гипотезы), почему распределение получилось именно таким. (1 б.)
hogwarts_semester1 <- hogwarts %>%
  select(id, bloodStatus, starts_with("week_")) %>%
  select(1:17) %>%
  mutate(total_points_sem1 = rowSums(select(., starts_with("week_")))) %>%
  group_by(bloodStatus) %>%
  summarise(total_points_sem1 = sum(total_points_sem1))

ggplot(hogwarts_semester1, aes(x = bloodStatus, y = total_points_sem1, fill = bloodStatus))+
  geom_bar(stat = "identity")+
  labs(title = "Распределение набранных баллов за 1-й семестр по происхождению студентов",
       x = "Происхождение",
       y = "Набранные баллы за 1-й семестр")+
  theme_bw()+
  theme_custom

Одной из ключевых причин такого распределения баллов может быть то, что полукровок значительно больше, чем чистокровных и магглорождённых студентов. Это объясняет, почему они получили больше итоговых баллов.

Поскольку полукровок больше, общее количество баллов, заработанных ими за первый семестр, будет выше из-за большего числа участников в этой группе, даже если их средние баллы аналогичны другим группам.

  1. Модифицируйте предыдущий график – отсортируйте столбцы в порядке убывания суммы баллов. Добавьте на график текстовые метки, отражающие число студентов каждого происхождения. Попробуйте использовать для этой задачи не geom_text, а geom_label. Настройте внешний вид geom_label по своему усмотрению. Поправьте название оси. Проинтерпретируйте график. Соотносится ли интерпретация с вашей гипотезой из пункта 1? (1 б.)
hogwarts_semester1 <- hogwarts %>%
  select(id, bloodStatus, starts_with("week_")) %>%
  select(1:17) %>%
  mutate(total_points_sem1 = rowSums(select(., starts_with("week_")))) %>%
  group_by(bloodStatus) %>%
  summarise(total_points = sum(total_points_sem1), 
            num_students = n()) %>%
  arrange(desc(total_points))

ggplot(hogwarts_semester1, aes(x = reorder(bloodStatus, -total_points), y = total_points, fill = bloodStatus))+
  geom_bar(stat = "identity")+
  geom_label(aes(label = paste0("Число студентов: ", num_students)), 
             size = 5, fill = "white", color = "black", label.padding = unit(0.25, "lines"))+
  labs(title = "Распределение набранных баллов за 1-й семестр по происхождению студентов",
       x = "Происхождение студентов",
       y = "Сумма набранных баллов за 1-й семестр")+
  theme_bw()+
  theme_custom

График подтверждает гипотезу о том, что основная причина такого высокого результата у студентов-полукровок — высокое количество студентов в этой группе.

  1. И снова измените график – добавьте на него разбивку не только по происхождению, но и по полу. Раскрасьте столбцы по происхождению. Сделайте подписи к столбцам читаемыми. Дайте графику название, измените, если требуется, название осей. Сделайте шаг для оси, на которой отображены очки, через каждую тысячу баллов. Разместите текстовые метки по правому краю графика. Настройте график таким образом, чтобы метки были видны целиком и не обрезались. Сохраните график на устройство.(1.5 б.)
hogwarts_semester1 <- hogwarts %>%
  select(id, bloodStatus, sex, starts_with("week_")) %>%
  select(1:17) %>%
  mutate(total_points_sem1 = rowSums(select(., starts_with("week_")))) %>%
  group_by(bloodStatus, sex) %>% 
  summarise(total_points = sum(total_points_sem1),  
            num_students = n(), .groups = 'drop') %>%
  arrange(desc(total_points))

ggplot(hogwarts_semester1, aes(x = reorder(bloodStatus, -total_points), y = total_points, fill = bloodStatus))+
  geom_bar(stat = "identity", position = position_dodge())+
  geom_label(aes(label = paste0("Кол-во: ", num_students)), 
             size = 4, fill = "white", color = "black", 
             label.padding = unit(0.25, "lines"), 
             position = position_dodge(width = 0.9), hjust = -0.2)+
  scale_y_continuous(breaks = seq(0, max(hogwarts_semester1$total_points), by = 1000))+
  labs(title = "Распределение набранных баллов за 1-й семестр по происхождению и полу студентов",
       x = "Происхождение студентов",
       y = "Сумма набранных баллов за 1-й семестр")+
  theme_bw()+
  theme_custom+
  theme(axis.text.x = element_text(angle = 45, hjust = 1))+
  facet_grid(. ~ sex)

ggsave("hogwarts_semester1_plot_facet.png", width = 10, height = 8)
  1. Изучите функцию coord_flip() . Как вы думаете, когда она может быть полезна? Как вы думаете, в чем ее плюсы и минусы? (дополнительные 0.5 б.)

Функция coord_flip() в ggplot2 позволяет поменять оси местами, улучшая читаемость и облегчая сравнение значений. Это полезно в разных ситуациях: для улучшения читаемости, сравнения категорий и изменения представления данных. Плюсы: улучшение читаемости, наглядность сравнения. Минусы: потеря привычного восприятия и сложности с легендой.

Разное

  1. Сравните распределение баллов за экзамен по зельеварению и за экзамен по древним рунам. Сделайте это тремя разными способами. Под разными способами понимаются идеологически разные геомы или способы группировки. Не считаются разными способами изменения константных визуальных параметров (цвет заливки, размер фигур) на сходных в остальном графиках. Объедините графики, таким образом, чтобы результирующий график имел два столбца и 2 строки. Два графика должны находиться в верхней строке и занимать равную площадь. Третий график должен занимать нижнюю строку целиком. (2 б).
exam_scores <- hogwarts %>%
  select(`Potions exam`, `Study of ancient runes exam`) %>%
  pivot_longer(cols = everything(), names_to = "exam", values_to = "score")

hist_plot <- ggplot(exam_scores, aes(x = score, fill = exam))+
  geom_histogram(position = "identity", alpha = 0.6, bins = 30)+
  labs(title = "Гистограмма баллов за экзамены",
       x = "Баллы",
       y = "Число студентов")+
  theme_minimal()

box_plot <- ggplot(exam_scores, aes(x = exam, y = score, fill = exam))+
  geom_boxplot()+
  labs(title = "Ящик с усами: Баллы за экзамены",
       x = "Экзамен",
       y = "Баллы")+
  theme_minimal()

density_plot <- ggplot(exam_scores, aes(x = score, fill = exam))+
  geom_density(alpha = 0.5)+
  labs(title = "Плотность распределения баллов за экзамены",
       x = "Баллы",
       y = "Плотность")+
  theme_minimal()

combined_plot <- (hist_plot | box_plot) / density_plot
combined_plot

  1. Визуализируйте средний балл по зельеварению студентов с различным происхождением. Вы вольны добавить дополнительные детали и информацию на график. Проинтерпретируйте результат. Как вы думаете, почему он именно такой? Если у вас есть гипотеза, проиллюстрируйте ее еще одним графиком (или графиками). Объедините их при помощи ggarrange. (по 1 б. за первый и график и правильную интерпретацию с подтверждением в виде второго графика и текстовой аргументации). Измените порядок ваших фигур на первом графике слева направо следующим образом: маглорожденные, чистокровные, полукровки.

Скорректируйте название оси. Если у вас возникают сложности, обратитесь к шпаргалке по пакету forcats от posit. (Дополнительные 0.5 б.)

average_scores <- hogwarts %>%
  group_by(bloodStatus) %>%
  summarise(avg_potions_score = mean(`Potions exam`, na.rm = TRUE)) %>%
  mutate(bloodStatus = fct_relevel(bloodStatus, "muggle-born", "pure-blood", "half-blood"))

avg_potions_plot <- ggplot(average_scores, aes(x = bloodStatus, y = avg_potions_score, fill = bloodStatus))+
  geom_bar(stat = "identity", position = "dodge")+
  labs(title = "Средний балл по зельеварению по происхождению студентов",
       x = "Происхождение",
       y = "Средний балл за экзамен по зельеварению")+
  theme_minimal()

boxplot_potions <- ggplot(hogwarts, aes(x = bloodStatus, y = `Potions exam`, fill = bloodStatus))+
  geom_boxplot()+
  labs(title = "Распределение баллов по зельеварению",
       x = "Происхождение",
       y = "Баллы за экзамен по зельеварению")+
  theme_minimal()

combined_plot <- ggarrange(avg_potions_plot, boxplot_potions, nrow = 2, ncol = 1)
combined_plot

ggsave("average_potions_distribution.png", plot = combined_plot, width = 8, height = 10)

Интерпретация результатов Мы видим, что маглорожденные студенты имеют более высокий средний балл по зельеварению, чем полукровные и чистокровные. Это может быть связано с тем, что маглорожденные студенты, возможно, более мотивированы или используют разные подходы к обучению, нежели чистокровные.

Воспроизведение графика

  1. Дополнительное задание на 4 балла. Воспроизведите график максимально близко к оригиналу и проинтерпретируйте его.
hogwarts %>%
  ggplot(aes(x = house, y = result, fill = house))+
  geom_violin(trim = TRUE, scale = "area")+ 
  geom_boxplot(width = 0.1, fill = "white")+
  stat_summary(fun = "mean", geom = "point", shape = 23, size = 3, fill = "brown")+  
  facet_wrap(~ sex, labeller = as_labeller(c("male" = "Мальчики", "female" = "Девочки")))+
  scale_y_continuous(breaks = seq(-300, 300, by = 50))+
  geom_hline(yintercept = 0, linetype = "dashed", color = "red", linewidth = 1.2)+
  scale_fill_manual(values = c("Gryffindor" = "#C50000", 
                             "Hufflepuff" = "#ECB939", 
                             "Ravenclaw" = "#41A6D9", 
                             "Slytherin" = "#1F5D25"))+
  labs(
    title = "Баллы студентов Хогвартса",
    subtitle = "Распределение числа баллов у студентов различных факультетов Хогвартса в 2023-2024 учебном году",
    x = "",
    y = "Количество очков",
    fill = "Факультет"
  )+
  theme_classic()+
  theme(
    plot.title = element_text(hjust = 0.5, size = 18),
    plot.subtitle = element_text(hjust = 0.5, size = 14, color = "brown"),
    axis.title.y = element_text(size = 14),
    axis.text.x = element_blank(),
    strip.text = element_text(size = 14),
    legend.title = element_text(size = 12),
    legend.text = element_text(size = 10),
    legend.position = c(.5, .2),
    legend.background = element_rect(fill = "transparent", colour = NA),
    legend.key = element_rect(fill = "transparent", colour = NA),
    strip.background = element_rect(fill = "gray90", colour = NA),
    panel.border = element_blank(),
    axis.line = element_blank(),
    axis.ticks = element_line(color = "black")
  )

На графике представлено распределение баллов среди студентов факультетов Хогвартса за учебный год 2023-2024.

Основные наблюдения: Половые различия: График не выявляет значительных различий в оценках между мальчиками и девочками, за исключением студентов Слизерина, где наблюдаются определённые отличия.